unit WbCenterFormUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,ShellApi;

type
  TPWB = class
  SN:Integer;
  NodeHWND:Integer;
  Url:String;
  Title:String;
  Protocol:String;
  Host:String;
  ReadyStateValue:Integer;
  WbHWND:HWND;
  PID:Integer;
  constructor Create();
  function IsReady():boolean;
  procedure TerminateNodeProcess();
  Destructor Destroy; override;
  function LocationURL():String;
  function ReadyState():Integer;
  function Name():String;
  procedure Hide();
  procedure SetSilent(b:boolean);
  procedure GoHome();
  procedure Navigate(s:String);
  procedure Show();
  procedure GoBack();
  procedure GoForward();
  procedure Refresh();
  function LocationName():String;
  function GetTitle():String;
  procedure Stop();
  procedure ExecWB(a,b:Integer);
  procedure ExecScript(s:String);
  function GetProtocol():String;
  function GetHost():String;
  procedure Repaint();

  end;

type
  TWbCenterForm = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure WMCopyData(var Msg : TWMCopyData) ; message WM_COPYDATA;
    function ProcessReceivedData(s:String):Integer;
    function SendData(h:HWND;const copyDataStruct: TCopyDataStruct):Integer;
    function SendString(h:HWND;s:String):Integer;
    function GetTargetHWND(n:Integer):HWND;
    function RemoteCall(Cmd:String;SN:Integer;Param:String):Integer;
    function Encode(s:String):String;
    function Decode(s:String):String;
  end;

var
  WbCenterForm: TWbCenterForm;
  WbParent:HWND;
  WbSn:Integer;
  PreparedWbNode:TPWB;
  wb: array [0 .. 100] of TPWB;
  wb_count: Integer;
  BrowserMainFormHandle:HWND;
  WbExecutiveFormHandle:HWND;
  DefaultBrowser:String;

const
  SeperateGuid = '{e5450621-9d35-4eee-b584-0e9072130860}';
  HyphenGuid = '{440e616b-9be5-4f1c-962a-1232fcae76fe}';
  NewLineGuid = '{4d4b9ad1-bb21-47d6-8323-8cbd95b81ee5}';


implementation

{$R *.dfm}

procedure DisplayMessage(Text: String; title: String);
begin
  MessageBox(0, PChar(Text), PChar(title), MB_ICONEXCLAMATION);
end;

constructor TPWB.Create;
var
Param:String;
begin
WbSn := WbSn + 1;
SN := WbSn;
WbHWND := 0;
NodeHWND := 0;
PID := 0;
end;

function TPWB.IsReady():boolean;
begin
if (WbHWND<>0) and (NodeHWND<>0) and (PID<>0) then
  Result := true
else
  Result := false;
end;

function TerminateProcessByID(ProcessID: Cardinal): Boolean;
//http://stackoverflow.com/questions/2550927/i-have-the-process-id-and-need-to-close-the-associate-process-programatically-wi
var
  hProcess : THandle;
begin
  Result := False;
  hProcess := OpenProcess(PROCESS_TERMINATE,False,ProcessID);
  if hProcess > 0 then
  try
    Result := Win32Check(Windows.TerminateProcess(hProcess,0));
  finally
    CloseHandle(hProcess);
  end;
end;
procedure TPWB.TerminateNodeProcess();
begin
  TerminateProcessByID(PID);
end;
function IsOnlyOneWbInProcess(sn:Integer;pid:Integer):boolean;
var
i:Integer;
begin
Result := true;
for i := 0 to wb_count - 1 do
  if wb[i].PID = pid then
    if wb[i].SN <> sn then
    begin
      Result := false;
      exit;
    end;
end;
Destructor  TPWB.Destroy;
begin
    //DisplayMessage('WbExecutiveFormHandle='+IntToStr(WbExecutiveFormHandle),'');
    WbCenterForm.SendString(WbExecutiveFormHandle,
                            'DeleteWbNodeBySN'+sLineBreak+
                            IntToStr(SN)
                            );
    TerminateNodeProcess;
    inherited;
end;

function TPWB.LocationURL():String;
begin
Result := Url;
end;
function TPWB.ReadyState():Integer;
begin
Result := ReadyStateValue;
end;
function TPWB.Name():String;
begin
Result := 'wb';
end;
procedure TPWB.Hide();
begin
ShowWindow(WbHWND,SW_HIDE);
//WbCenterForm.RemoteCall('Hide',SN,'');
end;
procedure TPWB.SetSilent(b:boolean);
begin
if b then WbCenterForm.RemoteCall('SetSilent',SN,'true')
else WbCenterForm.RemoteCall('SetSilent',SN,'false');
end;
procedure TPWB.GoHome();
begin
WbCenterForm.RemoteCall('GoHome',SN,'');
end;
procedure TPWB.Navigate(s:String);
begin
WbCenterForm.RemoteCall('Navigate',SN,WbCenterForm.Encode(s));
end;
procedure TPWB.Show();
begin
ShowWindow(WbHWND,SW_SHOW);
//WbCenterForm.RemoteCall('Show',SN,'');
end;
procedure TPWB.GoBack();
begin
WbCenterForm.RemoteCall('GoBack',SN,'');
end;
procedure TPWB.GoForward();
begin
WbCenterForm.RemoteCall('GoForward',SN,'');
end;
procedure TPWB.Refresh();
begin
WbCenterForm.RemoteCall('Refresh',SN,'');
end;
function TPWB.LocationName():String;
begin
Result := Title;
end;
function TPWB.GetTitle():String;
begin
Result := Title;
end;
procedure TPWB.Stop();
begin
WbCenterForm.RemoteCall('Stop',SN,'');
end;
procedure TPWB.ExecWB(a,b:Integer);
begin
WbCenterForm.RemoteCall('ExecWB',SN,IntToStr(a)+SeperateGuid+IntToStr(b));
end;
procedure TPWB.ExecScript(s:String);
begin
WbCenterForm.RemoteCall('ExecScript',SN,WbCenterForm.Encode(s));
end;
function TPWB.GetProtocol():String;
begin
Result := Protocol;
end;
function TPWB.GetHost():String;
begin
Result := Host;
end;
procedure TPWB.Repaint();
begin
WbCenterForm.RemoteCall('Repaint',SN,'');
end;

function SnToIndex(n:Integer):Integer;
var
i:Integer;
begin
Result := -1;
for i := 0 to wb_count - 1 do
  if wb[i].SN = n then
  begin
    Result := i;
    exit;
  end;
end;

procedure TWbCenterForm.FormCreate(Sender: TObject);
begin
WbSn := 0;
PreparedWbNode := nil;
end;

function TWbCenterForm.ProcessReceivedData(s:String):Integer;
var
sl:TStringList;
TempString:String;
sl2:TStringList;
index:Integer;
IsTitleChanged:boolean;
begin
sl := TStringList.Create;
sl.Text := s;
if sl.Strings[0] = 'Update' then
begin
  index := SnToIndex(StrToInt(sl.Strings[1]));
  if index<>-1 then
  begin
    TempString := sl.Strings[2];
    TempString := StringReplace(TempString, SeperateGuid, sLineBreak,[rfReplaceAll, rfIgnoreCase]);
    sl2 := TStringList.Create;
    sl2.Text := TempString;
    if sl2.Count = 5 then
    //Sometimes the values are empty, then sl2 does not have 4 strings.
    //This would cause "out of bounds" error. Fix: check "Count" before handling.
    begin
      wb[index].Url := Decode(sl2.Strings[0]);
      if wb[index].Title = Decode(sl2.Strings[1]) then IsTitleChanged := false
      else IsTitleChanged := true;
      wb[index].Title := Decode(sl2.Strings[1]);
      wb[index].Protocol := Decode(sl2.Strings[2]);
      wb[index].Host := Decode(sl2.Strings[3]);
      wb[index].ReadyStateValue := StrToInt(sl2.Strings[4]);
    end;
    sl2.Free;
    if IsTitleChanged then
      SendString(BrowserMainFormHandle,'TitleChanged'+sLineBreak+IntToStr(index));

  end;//forgot this!
end
else if sl.Strings[0] = 'WbNodeInit' then
begin
    TempString := sl.Strings[2];
    TempString := StringReplace(TempString, SeperateGuid, sLineBreak,[rfReplaceAll, rfIgnoreCase]);
    sl2 := TStringList.Create;
    sl2.Text := TempString;
    Result := WbSn + 1;
    //Error: Result is wrong.
    //Fix: set "Result" before sending "NodeHasNewWb-NewTab".
    //Cause: "NodeHasNewWb-NewTab" will call "TPWB.Create"(WbSn:=WbSn+1).
    PreparedWbNode := TPWB.Create;
    PreparedWbNode.NodeHWND := StrToInt(Decode(sl2.Strings[0]));
    PreparedWbNode.WbHWND := StrToInt(Decode(sl2.Strings[1]));
    PreparedWbNode.PID := StrToInt(Decode(sl2.Strings[2]));
    SendString(PreparedWbNode.NodeHWND,
                'WbParent'+sLineBreak+
                ''+sLineBreak+
                IntToStr(WbParent)
              );
    SendString(PreparedWbNode.NodeHWND,
                'DefaultBrowser'+sLineBreak+
                ''+sLineBreak+
                DefaultBrowser
              );

    {
    SendString(BrowserMainFormHandle,
                'NodeHasNewWb-NewTab'+sLineBreak+
                Decode(sl2.Strings[0])+sLineBreak+
                Decode(sl2.Strings[1])+sLineBreak+
                Decode(sl2.Strings[2])
              );
    }
    sl2.Free;
end
else if sl.Strings[0]='NewWindow2' then
begin
  SendString(BrowserMainFormHandle,'NewWindow2');
end;


sl.Free;
end;

procedure TWbCenterForm.WMCopyData(var Msg: TWMCopyData) ;
 var
 s : string;
 begin
 s := PChar(Msg.CopyDataStruct.lpData) ;
 //ShowMessage('s="'+s+'"');
 msg.Result := ProcessReceivedData(s);
 //Send something back
 //msg.Result := 2006;
end;

function TWbCenterForm.SendData(h:HWND;const copyDataStruct: TCopyDataStruct):Integer;
 var
   receiverHandle : THandle;
   res : integer;
 begin
   receiverHandle := h;
   if receiverHandle = 0 then
   begin
     //ShowMessage('CopyData Receiver NOT found!') ;
     Exit;
   end;
   Result := SendMessage(receiverHandle, WM_COPYDATA, Integer(Handle), Integer(@copyDataStruct)) ;
 end;

function TWbCenterForm.SendString(h:HWND;s:String):Integer;
var
 stringToSend : string;
 copyDataStruct : TCopyDataStruct;
 begin
 stringToSend := s;
 copyDataStruct.dwData := 0; //use it to identify the message contents
 copyDataStruct.cbData := (1 + Length(stringToSend))*2 ;//modified
 copyDataStruct.lpData := PChar(stringToSend) ;
 Result := SendData(h,copyDataStruct) ;
 end;

function TWbCenterForm.GetTargetHWND(n:Integer):HWND;
var
i:Integer;
begin
Result := 0;
for i:=0 to wb_count - 1 do
  if wb[i].SN=n then
  begin
    Result := wb[i].NodeHWND;
    Exit;
  end;
end;

function TWbCenterForm.RemoteCall(Cmd:String;SN:Integer;Param:String):Integer;
var
sl:TStringList;
s:String;
TargetHWND:HWND;
begin
sl := TStringList.Create;
sl.Add(Cmd);
sl.Add(IntToStr(SN));
sl.Add(Param);
s := sl.Text;
sl.Free;
TargetHWND := GetTargetHWND(SN);
//ShowMessage('TWbCenterForm.RemoteCall - TargetHWND='+IntToStr(TargetHWND));
//ShowMessage('TWbCenterForm.RemoteCall - s="'+s+'"');
Result := SendString(TargetHWND,s);
end;

function TWbCenterForm.Encode(s:String):String;
begin
Result := s;
//encode "-" first - NewLineGuid also has "-" and we don't want to encode it.
Result := StringReplace(Result, '-', HyphenGuid,[rfReplaceAll, rfIgnoreCase]);
Result := StringReplace(Result, sLineBreak, NewLineGuid,[rfReplaceAll, rfIgnoreCase]);
end;
function TWbCenterForm.Decode(s:String):String;
begin
Result := s;
//"-" decoding is the last decoding ...
//because decoded "-" char should never be further decoded.
Result := StringReplace(Result, NewLineGuid, sLineBreak, [rfReplaceAll, rfIgnoreCase]);
Result := StringReplace(Result, HyphenGuid, '-', [rfReplaceAll, rfIgnoreCase]);
end;



end.
